home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / qbfaqr01.zip / HUFFMAN2.BAS < prev    next >
BASIC Source File  |  1992-07-13  |  16KB  |  516 lines

  1. ' Huffman encoder v2.00 for PDS & QB4.5
  2. ' by Rich Geldreich May 29th, 1992
  3. ' Revised for PDS July 13, 1992
  4. ' This program is in the public domain. Use it for what you want!
  5. ' Just give me credit. If you find any bugs in it, please tell me about
  6. ' them.
  7. '
  8. ' QB4.5 users: use search & replace and change all of the "SSEG" strings
  9. ' in this program to "VARSEG" strings.
  10. ' Do not press ctrl+break while this program is compressing! The string
  11. ' pointers may change, which may result in an error! Also, to realize
  12. ' the true speed of this program you must run it compiled.
  13. ' The overall compression of this program is not optimal, because the
  14. ' entire tree is sent to the output file. This was done so the decoding
  15. ' program can be as simple and fast as possible(the tree takes up about
  16. ' 1000 bytes or so; it depends on the input file).
  17. '
  18. ' This program is much, much better than my first huffman encoder. It's
  19. ' faster, and (should be) easier to understand. The entire program was
  20. ' rewritten from scratch. The following changes have been made:
  21.  
  22. ' The huffman tree is now scanned using a recursive algorithm instead of
  23. ' a slow, down-up search.
  24. ' Instead of searching for the lowest 2 nodes using a slow, linear search,
  25. ' this program uses a much faster presorted table. The entire tree can
  26. ' be combined in less than a second on my 286-10!
  27. ' The input file is scanned & compressed with a very fast buffer loading
  28. ' system, to overcome QB's slowness with binary files.
  29. ' A new shell sort is used to sort the node table before the tree is
  30. ' combined. A simple bubble sort is then used thereafter.
  31. '
  32.  
  33.  
  34.  
  35. DEFINT A-Z
  36. DECLARE SUB InitTree ()
  37. DECLARE SUB MakeSortTable ()
  38. DECLARE SUB CombineTree ()
  39. DECLARE SUB CleanUpTree ()
  40. DECLARE SUB WriteTree ()
  41.  
  42. DECLARE SUB SortDistribution2 ()
  43. DECLARE SUB SortDistribution ()
  44. DECLARE SUB GetDistribution ()
  45. DECLARE SUB RecurseTree (Node)
  46.  
  47. DECLARE SUB FillBuffer ()
  48.  
  49.  
  50. CONST True = -1, False = 0
  51. CONST Null = -2
  52. CONST BufferLength = 10000
  53.  
  54. CLEAR , , 10000
  55.  
  56. DIM SHARED Father(512) AS LONG, LeftSon(512), RightSon(512)
  57. DIM SHARED Index(512), RealIndex, Used(255) AS LONG
  58. DIM SHARED Pointer(255), HighestEntry
  59. DIM SHARED Code(255, 40), CodeLength(255)
  60. DIM SHARED CurrentLength, CurrentCode(40)
  61.  
  62. DIM SHARED Buffer$, Address, EndAddress, Bits(8), CurrentByte, CurrentBit
  63. DIM SHARED BufferSeg
  64.  
  65.  
  66. LOCATE , , 1
  67.  
  68.  
  69. Bits:
  70.     DATA 1,2,4,8,16,32,64,128,256
  71.  
  72. 'read the bit masks
  73. RESTORE Bits
  74. FOR A = 0 TO 8: READ Bits(A): NEXT
  75.  
  76. 'initialize the tree
  77. InitTree
  78.  
  79. 'initialize the input buffer
  80. Buffer$ = STRING$(BufferLength, 0)
  81. EndAddress = 1: Address = 0
  82.  
  83. PRINT "Getting Distribution:";
  84. 'open input file
  85. OPEN COMMAND$ FOR BINARY AS #1
  86. 'check to see if it exists
  87. IF LOF(1) = 0 THEN
  88.     CLOSE #1
  89.     KILL COMMAND$
  90.     PRINT
  91.     PRINT COMMAND$; " not found"
  92.     END
  93. END IF
  94. 'read the input file and gather the distribution of each character
  95. GetDistribution
  96. 'make a sorting table
  97. MakeSortTable
  98. 'sort the table with the a shell sort
  99. SortDistribution
  100. 'combine the tree until there is only one node at the "top"
  101. CombineTree
  102. 'work down the tree finding codes which represent each character
  103. TopOfTree = Pointer(0)
  104. CurrentLength = 0
  105. RecurseTree TopOfTree
  106. 'for debugging: prints the code for each character
  107. 'FOR A = 0 TO 255
  108. '    IF Used(A) > 256 THEN
  109. '        PRINT A;
  110. '        FOR B = 0 TO CodeLength(A)
  111. '            PRINT Code(A, B);
  112. '        NEXT
  113. '        PRINT
  114. '    END IF
  115. 'NEXT
  116. 'STOP
  117. '"cleans" the tree up so it can be sent as small as possible
  118. CleanUpTree
  119.  
  120. CurrentByte = 0: CurrentBit = 0
  121. RealIndex = RealIndex - 1
  122. 'open output file
  123. OPEN "output.huf" FOR BINARY AS #2
  124. 'kill file if it already exists
  125. IF LOF(2) <> 0 THEN
  126.     CLOSE #2
  127.     KILL "output.huf"
  128.     OPEN "output.huf" FOR BINARY AS #2
  129. END IF
  130.  
  131. 'put the header
  132. A& = LOF(1)
  133. PUT #2, , A&            'number of bytes in original file
  134. PUT #2, , RealIndex     'number of nodes in tree
  135. Top = Index(TopOfTree)
  136. PUT #2, , Top           'top of tree
  137.  
  138. WriteTree               'writes the tree to the output file
  139.  
  140. 'compresses the input file
  141. PRINT : PRINT "Encoding...": PRINT : PRINT
  142. Ypos = CSRLIN - 2
  143.  
  144. SEEK #1, 1
  145. EndAddress = 1: Address = 0
  146. 'initialize the output buffer
  147. A$ = STRING$(5000, 0)
  148. A& = SADD(A$)
  149. A& = A& - 65536 * (A& < 0)
  150. OBufferSeg = SSEG(A$) + (A& \ 16)
  151. OAddress = (A& MOD 16)
  152. OEndAddress = OAddress + 5000
  153. Ostart = OAddress
  154. 'start compressing
  155. FOR A& = 1 TO LOF(1)
  156.    
  157.     'get a byte from the input file
  158.     Address = Address + 1
  159.     'if Address=EndBuffer then it's time to fill the input buffer
  160.     IF Address = EndAddress THEN FillBuffer
  161.     B = PEEK(Address)
  162.     'send out all of the bits that represent the input character
  163.     FOR C = 0 TO CodeLength(B)
  164.         IF Code(B, C) THEN
  165.             CurrentByte = CurrentByte * 2 OR 1      'send "1"
  166.         ELSE
  167.             CurrentByte = CurrentByte * 2           'send "0"
  168.         END IF
  169.         CurrentBit = CurrentBit + 1
  170.         'if CurrentBit=8 then we have a complete byte
  171.         IF CurrentBit = 8 THEN
  172.             DEF SEG = OBufferSeg
  173.             POKE OAddress, CurrentByte
  174.             OAddress = OAddress + 1
  175.             'if Oaddress=Oendaddress then it's time to flush the
  176.             'output buffer
  177.             IF OAddress = OEndAddress THEN
  178.                 PUT #2, , A$
  179.                 B& = SADD(A$)
  180.                 B& = B& - 65536 * (B& < 0)
  181.                 OBufferSeg = SSEG(A$) + (B& \ 16)
  182.                 OAddress = (B& MOD 16)
  183.                 OEndAddress = OAddress + 5000
  184.                 Ostart = OAddress
  185.             END IF
  186.             CurrentByte = 0: CurrentBit = 0
  187.             DEF SEG = BufferSeg
  188.         END IF
  189.     NEXT
  190.     'see if it's time to update screen
  191.     PrintCount = PrintCount + 1
  192.     IF PrintCount = 1024 THEN
  193.         PrintCount = 0
  194.         LOCATE Ypos, 1
  195.         PRINT "Bytes In:"; A&; (A& * 100&) \ LOF(1); "%  "
  196.         B& = LOF(2) + OAddress - Ostart
  197.         PRINT "Bytes Out:"; B&; "   "
  198.         PRINT "Compression:"; 100 - (B& * 100&) \ A&; "% ";
  199.     END IF
  200. NEXT
  201. 'put whatever is left of the byte buffer into the output buffer
  202. DO UNTIL CurrentBit = 8
  203.     CurrentByte = CurrentByte * 2
  204.     CurrentBit = CurrentBit + 1
  205. LOOP
  206.  
  207. DEF SEG = OBufferSeg
  208. POKE OAddress, CurrentByte
  209. A$ = LEFT$(A$, OAddress + 1 - Ostart)
  210. PUT #2, , A$
  211. 'report compression
  212. LOCATE Ypos, 1
  213. PRINT "Bytes In:"; LOF(1); SPACE$(16)
  214. PRINT "Bytes Out:"; LOF(2); SPACE$(16)
  215. PRINT "Overall Compression:"; 100 - (LOF(2) * 100&) \ LOF(1); "%"; SPACE$(16);
  216. CLOSE
  217.  
  218. END
  219.  
  220. '"Cleans" up the tree so it can be sent.
  221. SUB CleanUpTree
  222.     RealIndex = 0
  223.     FOR A = 0 TO 512
  224.         B& = Father(A)
  225.         IF B& <> Null THEN
  226.             IF B& < 256 THEN
  227.                 IF Used(B&) > 256 THEN
  228.                     Index(A) = RealIndex
  229.                     RealIndex = RealIndex + 1
  230.                 END IF
  231.             ELSEIF B& > 256 THEN
  232.                 Index(A) = RealIndex
  233.                 RealIndex = RealIndex + 1
  234.             END IF
  235.         END IF
  236.     NEXT
  237.  
  238.     FOR A = 0 TO 512
  239.         B& = Father(A)
  240.         IF B& <> Null THEN
  241.             IF B& < 256 THEN
  242.                 IF Used(B&) > 256 THEN
  243.                     IF LeftSon(A) <> Null THEN
  244.                         LeftSon(A) = Index(LeftSon(A))
  245.                     END IF
  246.                     IF RightSon(A) <> Null THEN
  247.                         RightSon(A) = Index(RightSon(A))
  248.                     END IF
  249.                 END IF
  250.             ELSEIF B& > 256 THEN
  251.                 IF LeftSon(A) <> Null THEN
  252.                     LeftSon(A) = Index(LeftSon(A))
  253.                 END IF
  254.                 IF RightSon(A) <> Null THEN
  255.                     RightSon(A) = Index(RightSon(A))
  256.                 END IF
  257.             END IF
  258.         END IF
  259.     NEXT
  260. END SUB
  261.  
  262. 'Combines the tree until there is only one node at the top.
  263. SUB CombineTree
  264.    
  265.     Parents = HighestEntry + 1
  266.     DO UNTIL Parents = 1
  267.         'sort the current distribution
  268.         SortDistribution2
  269.         'find the lowest 2 entries
  270.         Lowest = Pointer(HighestEntry)
  271.         NextLowest = Pointer(HighestEntry - 1)
  272.         'find new frequency
  273.         NewFrequency& = Father(Lowest) + Father(NextLowest) - 256
  274.         'combine the two nodes
  275.         IF RightSon(Lowest) = Null AND RightSon(NextLowest) = Null THEN
  276.             Father(NextLowest) = NewFrequency&
  277.             RightSon(NextLowest) = LeftSon(Lowest)
  278.             Father(Lowest) = Null
  279.             Parents = Parents - 1
  280.             HighestEntry = HighestEntry - 1
  281.         ELSEIF RightSon(Lowest) = Null AND RightSon(NextLowest) <> Null THEN
  282.             Father(Lowest) = NewFrequency&
  283.             RightSon(Lowest) = NextLowest
  284.             Pointer(HighestEntry - 1) = Pointer(HighestEntry)
  285.             Parents = Parents - 1
  286.             HighestEntry = HighestEntry - 1
  287.         ELSEIF RightSon(Lowest) <> Null AND RightSon(NextLowest) = Null THEN
  288.             Father(NextLowest) = NewFrequency&
  289.             RightSon(NextLowest) = Lowest
  290.             Parents = Parents - 1
  291.             HighestEntry = HighestEntry - 1
  292.         ELSEIF RightSon(Lowest) <> Null AND RightSon(NextLowest) <> Null THEN
  293.             'search for new node
  294.             FOR A = 512 TO 0 STEP -1
  295.                 IF Father(A) = Null THEN EXIT FOR
  296.             NEXT
  297.             Father(A) = NewFrequency&
  298.             LeftSon(A) = Lowest
  299.             RightSon(A) = NextLowest
  300.       
  301.             HighestEntry = HighestEntry - 1
  302.             Pointer(HighestEntry) = A
  303.             Parents = Parents - 1
  304.         END IF
  305.     'loop until there is only one node at the top
  306.     LOOP
  307. END SUB
  308.  
  309. 'Fills the input buffer.
  310. SUB FillBuffer
  311.     GET #1, , Buffer$
  312.  
  313.     A& = SADD(Buffer$)
  314.     A& = A& - 65536 * (A& < 0)
  315.     BufferSeg = SSEG(Buffer$) + (A& \ 16)
  316.     Address = (A& MOD 16)
  317.     EndAddress = Address + BufferLength
  318.     DEF SEG = BufferSeg
  319.  
  320. END SUB
  321.  
  322. 'Scans the input file for it's distribution.
  323. SUB GetDistribution
  324.        
  325.     FOR A& = 1 TO LOF(1)
  326.         Address = Address + 1
  327.         IF Address = EndAddress THEN
  328.             FillBuffer
  329.             PRINT ".";
  330.         END IF
  331.         B = PEEK(Address) * 2
  332.         Father(B) = Father(B) + 1
  333.     NEXT
  334.     B = 0
  335.     FOR A = 0 TO 510 STEP 2
  336.         Used(B) = Father(A): B = B + 1
  337.     NEXT
  338. END SUB
  339.  
  340. 'Initilizes the tree.
  341. SUB InitTree
  342.     B = 0
  343.     FOR A = 0 TO 510 STEP 2
  344.   
  345.         Father(A) = 256
  346.         LeftSon(A) = A + 1
  347.         RightSon(A) = Null
  348.   
  349.         Father(A + 1) = B
  350.         LeftSon(A + 1) = Null
  351.         RightSon(A + 1) = Null
  352.   
  353.         B = B + 1
  354.     NEXT
  355. END SUB
  356.  
  357. 'Makes a sorting table.
  358. SUB MakeSortTable
  359.     HighestEntry = 0
  360.     FOR A = 0 TO 510 STEP 2
  361.         IF Father(A) > 256 THEN
  362.             Pointer(HighestEntry) = A
  363.             HighestEntry = HighestEntry + 1
  364.         END IF
  365.     NEXT
  366.     HighestEntry = HighestEntry - 1
  367. END SUB
  368.  
  369. 'Recursize procedure to go down the tree and build up codes
  370. 'that represent each character.
  371. SUB RecurseTree (Node)
  372.     'are we at a character?
  373.     IF Father(Node) < 256 THEN
  374.         'yup! we CurrentCode() has this character's bit sequence
  375.         Char = Father(Node)
  376.         FOR A = 0 TO CurrentLength - 1
  377.             Code(Char, A) = CurrentCode(A)
  378.         NEXT
  379.         CodeLength(Char) = CurrentLength - 1
  380.     END IF
  381.     'go to the left if there's something there
  382.     IF LeftSon(Node) <> Null THEN
  383.         CurrentCode(CurrentLength) = 1      'add "1" to the current code
  384.         CurrentLength = CurrentLength + 1
  385.         RecurseTree LeftSon(Node)           'go down
  386.         CurrentLength = CurrentLength - 1   'take "1" from the current code
  387.     END IF
  388.     'go to the right if there's something there
  389.     IF RightSon(Node) <> Null THEN
  390.         CurrentCode(CurrentLength) = 0      'add "0" to the current code
  391.         CurrentLength = CurrentLength + 1
  392.         RecurseTree RightSon(Node)          'got down
  393.         CurrentLength = CurrentLength - 1   'take "0" from the current code
  394.     END IF
  395. END SUB
  396.  
  397. 'A REAL Shell sort follows. It is much faster than the well-known one.
  398. 'Sorts the nodes according to the sorting table.
  399. SUB SortDistribution
  400.     Offset = HighestEntry \ 2
  401.     DO
  402.         FOR I = 0 TO HighestEntry - Offset
  403.             IF Father(Pointer(I)) < Father(Pointer(I + Offset)) THEN
  404.                 SWAP Pointer(I), Pointer(I + Offset)
  405.                 CompareLow = I - Offset
  406.                 CompareHigh = I
  407.                 DO WHILE CompareLow >= 0
  408.                     IF Father(Pointer(CompareLow)) < Father(Pointer(CompareHigh)) THEN
  409.                         SWAP Pointer(CompareLow), Pointer(CompareHigh)
  410.                         CompareHigh = CompareLow
  411.                         CompareLow = CompareLow - Offset
  412.                     ELSE
  413.                         EXIT DO
  414.                     END IF
  415.                 LOOP
  416.             END IF
  417.         NEXT
  418.         Offset = Offset \ 2
  419.     LOOP WHILE Offset > 0
  420.     
  421.  
  422. END SUB
  423.  
  424. 'A simple bubble sort... used while combining the tree.
  425. SUB SortDistribution2
  426.     
  427.     DO
  428.         SwapFlag = False
  429.         FOR A = HighestEntry - 1 TO 0 STEP -1
  430.             IF Father(Pointer(A + 1)) > Father(Pointer(A)) THEN
  431.                 SWAP Pointer(A + 1), Pointer(A)
  432.                 SwapFlag = True
  433.             END IF
  434.         NEXT
  435.     LOOP WHILE SwapFlag
  436.     
  437. END SUB
  438.  
  439. 'Writes the tree to disk.
  440. SUB WriteTree
  441.     
  442.  
  443.     FOR A = 0 TO 512
  444.         B& = Father(A)
  445.         IF B& <> Null THEN
  446.             IF B& < 256 THEN
  447.                 IF Used(B&) > 256 THEN
  448.                     GOSUB SendOne
  449.                     FOR C = 0 TO 7
  450.                         IF (B& AND Bits(C)) > 0 THEN
  451.                             GOSUB SendOne
  452.                         ELSE
  453.                             GOSUB SendZero
  454.                         END IF
  455.                     NEXT
  456.                 END IF
  457.             ELSEIF B& > 256 THEN
  458.                 GOSUB SendZero
  459.                 IF LeftSon(A) <> Null THEN
  460.                     GOSUB SendOne
  461.                     Son = LeftSon(A)
  462.                
  463.                     FOR C = 0 TO 8
  464.                         IF (Son AND Bits(C)) > 0 THEN
  465.                             GOSUB SendOne
  466.                         ELSE
  467.                             GOSUB SendZero
  468.                         END IF
  469.                     NEXT
  470.                 ELSE
  471.                     GOSUB SendZero
  472.                 END IF
  473.                 IF RightSon(A) <> Null THEN
  474.                     GOSUB SendOne
  475.                     Son = RightSon(A)
  476.                    
  477.                     FOR C = 0 TO 8
  478.                         IF (Son AND Bits(C)) > 0 THEN
  479.                             GOSUB SendOne
  480.                         ELSE
  481.                             GOSUB SendZero
  482.                         END IF
  483.                     NEXT
  484.                 ELSE
  485.                     GOSUB SendZero
  486.                 END IF
  487.             END IF
  488.         END IF
  489.     NEXT
  490.  
  491.     EXIT SUB
  492.  
  493. SendZero:
  494.     CurrentByte = CurrentByte * 2
  495.     CurrentBit = CurrentBit + 1
  496.     IF CurrentBit = 8 THEN
  497.         A$ = CHR$(CurrentByte)
  498.         PUT #2, , A$
  499.         CurrentByte = 0: CurrentBit = 0
  500.     END IF
  501. RETURN
  502.  
  503. SendOne:
  504.    
  505.     CurrentByte = CurrentByte * 2 OR 1
  506.     CurrentBit = CurrentBit + 1
  507.     IF CurrentBit = 8 THEN
  508.         A$ = CHR$(CurrentByte)
  509.         PUT #2, , A$
  510.         CurrentByte = 0: CurrentBit = 0
  511.     END IF
  512. RETURN
  513.  
  514. END SUB
  515.  
  516.